Classification Models for Computer Vision

Hand-Written Digit Classifiation

In this module, we will examine the MNIST dataset, which is a set of 70,000 images of digits handwritten by high school students and employees of the US Census Bureau.

MNIST is considered the “hello-world” of the machine-learning world, and is often a good place to start for understanding classification algorithms.

Let’s load the MNIST dataset.

library(MicrosoftML)
library(tidyverse)

Loading tidyverse: ggplot2
Loading tidyverse: tibble
Loading tidyverse: tidyr
Loading tidyverse: readr
Loading tidyverse: purrr
Loading tidyverse: dplyr
Conflicts with tidy packages ---------------------------------------------------------------
filter(): dplyr, stats
lag():    dplyr, stats

library(magrittr)

Attaching package: ‘magrittr’

The following object is masked from ‘package:purrr’:

    set_names

The following object is masked from ‘package:tidyr’:

    extract

library(dplyrXdf)
theme_set(theme_minimal())
mnist_xdf <- file.path("..", "data", "MNIST.xdf")
mnist_xdf <- RxXdfData(mnist_xdf)

Let’s take a look at the data:

rxGetInfo(mnist_xdf)

File name: /home/alizaidi/learnAnalytics-MicrosoftML/Student-Resources/data/MNIST.xdf 
Number of observations: 70000 
Number of variables: 786 
Number of blocks: 7 
Compression type: zlib 

Our dataset contains 70K records, and 786 columns. There are actually 784 features, because each image in the dataset is a 28x28 pixel image. The two additional columns are for the label, and a column with a pre-sampled train and test split.

Visualizing Digits

Let’s make some visualizations to examine the MNIST data and see what we can use for a classifier to classify the digits.

mnist_df <- rxDataStep(inData = mnist_xdf, outFile = NULL,
                       maxRowsByCols = nrow(mnist_xdf)*ncol(mnist_xdf)) %>% tbl_df

Let’s see the average for each digit:

mnist_df %>% 
  keep(is.numeric) %>% 
  rowMeans() %>% data.frame(intensity = .) %>% 
  tbl_df %>% 
  bind_cols(mnist_df) %T>% print -> mnist_df

Visualize average intensity by label:

ggplot(mnist_df, aes(x = intensity, y = ..density..)) +
  geom_density(aes(fill = Label), alpha = 0.3)

Let’s try a boxplot:

ggplot(mnist_df, aes(x = Label, y = intensity)) +
  geom_boxplot(aes(fill = Label), alpha = 0.3)

Visualize Digits

Let’s plot a sample set of digits:

flip <- function(matrix) {
      apply(matrix, 2, rev)
}
plot_digit <- function(samp) {
  
  digit <- unlist(samp)
  m <- flip(matrix(rev(as.numeric(digit)), nrow = 28))
  image(m, col = grey.colors(255))
  
}
mnist_df[11, ] %>% 
  select(-Label, -intensity, -splitVar) %>% 
  sample_n(1) %>% 
  rowwise() %>% plot_digit

Split the Data into Train and Test Sets

splits <- rxSplit(mnist_xdf,
                  splitByFactor = "splitVar", 
                  overwrite = TRUE)
names(splits) <- c("train", "test")

Let’s first train a softmax classifier using the rxLogisticRegression:

softmax <- estimate_model(xdf_data = splits$train,
                          form = make_form(splits$train, 
                                           resp_var = "Label", 
                                           vars_to_skip = c("splitVar")),
                          model = rxLogisticRegression,
                          type = "multiClass")

Automatically adding a MinMax normalization transform, use 'norm=Warn' or 'norm=No' to turn this behavior off.
LBFGS multi-threading will attempt to load dataset into memory. In case of out-of-memory issues, turn off multi-threading by setting trainThreads to 1.
Beginning optimization
num vars: 7850
improvement criterion: Mean Improvement
L1 regularization selected 3712 of 7850 weights.
Not training a calibrator because it is not needed.
Elapsed time: 00:00:17.4634647
Elapsed time: 00:00:00.0938839

Let’s see how we did. Let’s examine our results on the train set:

softmax_scores <- rxPredict(modelObject = softmax, 
                            data = splits$test, 
                            outData = tempfile(fileext = ".xdf"),
                            overwrite = TRUE,
                            extraVarsToWrite = "Label")

Elapsed time: 00:00:00.9884308

We can make a confusion matrix of all our results:

rxCube( ~ Label : PredictedLabel , data = softmax_scores,
       returnDataFrame = TRUE) -> softmax_scores_df
softmax_scores_df %>% ggplot(aes(x = Label, y = PredictedLabel,
                                 fill = Counts)) +
  geom_raster() +
  scale_fill_continuous(low = "steelblue2", high = "mediumblue")

Here we are plotting the raw counts. This might unfairly represent the more populated classes. Let’s weight each count by the total number of samples in that class:

label_rates <- softmax_scores_df %>% 
  tbl_df %>% 
  group_by(Label) %>% 
  mutate(rate = Counts/sum(Counts))
label_rates %>% ggplot(aes(x = Label, y = PredictedLabel, fill = rate)) +
  geom_raster() +
  scale_fill_continuous(low = "steelblue2", high = "mediumblue")

Let’s fill out all the correct scores with zeros so we can see the errors more clearly:

label_rates %>%
  mutate(error_rate = ifelse(Label == PredictedLabel,
                             0, rate)) %>% 
  ggplot(aes(x = Label, y = PredictedLabel, fill = error_rate)) +
  geom_raster() +
  scale_fill_continuous(low = "steelblue2", high = "mediumblue",
                        labels = scales::percent)

Exercises

1. Take a look at David Robinson’s tweet on using a single pixel to distinguish between pairs of digits.
2. You can find his gist saved in the Rscripts directory.